00100	TITLE MEM
00200	;-----------------------------------------------------------------
00300	INTERN OLD44,UNIVER,BLKCNT,AVAIL
00400		OLD44:	0
00500		UNIVER:	0
00600		BLKCNT: 0
00700		AVAIL:	0
00800		REMAINDER:0
00900		NODSIZ←←=12	;NUMBER OF WORDS PER NODE.
01000	SUBR(MORCOR)------------------------------------------------------
01100	BEGIN MORCOR; - GET MORE CORE - BGB - 4 DEC 1972.
01200	
01300	;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
01400		SKIPE OLD44↔GO L1
01500		LAC 1,44↔DAC 1,OLD44
01600		ADDI 1,1↔
01700		ADDI 1,1↔DAC 1,AVAIL
01800		ADDI 1,1↔DAC 1,BLKCNT
01900		ADDI 1,1↔DAC 1,UNIVERSE
02000		SETZM REMAINDER
02100	
02200	;FOUR MORE K.
02300	L1:	LAC 1,44↔LAC 0,1↔ADDI 0,10000
02400		CALLI 11↔GO[FATAL(NO MORE CORE.)]
02500		AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
02600		SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
02700		LACI 2↔DAP @UNIVERSE
02800	
02900	;MAKE AVAIL LIST.
03000		DIP 1,1↔ADD 1,[XWD NODSIZ,0]
03100		SKIPN@BLKCNT↔GO[
03200			ADD 1,[XWD NODSIZ,NODSIZ]
03300			AOS@BLKCNT↔GO .+1]
03400		DAPZ 1,@AVAIL
03500	L2:	HLRZM 1,(1)↔AOS 3(1)	;EMPTY LINK & EMPTY TYPE-1.
03600		ADD 1,[XWD NODSIZ,NODSIZ]
03700		CAILE 2,NODSIZ+NODSIZ-1(1)
03800		GO L2↔AOS 3(1)
03900	
04000		SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
04100		LACI 10000↔LAC 1,UNIVER↔ADDM -3(1)	;CORE SIZE.
04200		LAC 1,@AVAIL
04300		LAC 2,AC2↔POP0J
04400	
04500	BEND;1/12/73------------------------------------------------------
     

00100	SUBR(MKNODE)TYPE--------------------------------------------------
00200	BEGIN MKNODE;ALLOCATE A BLOCK OF NODSIZ WORDS.
00300		SKIPN 1,@AVAIL↔CALL(MORCOR)
00400		CDR(1)↔DAP @AVAIL
00500		SETZM(1)↔AOS @BLKCNT↔ADDI 1,3
00600		POP P,.+3↔POP P,(1)↔GO @.+1↔0
00700	BEND MKNODE; BGB 4 DEC 1972 --------------------------------------
00800	
00900	SUBR(KLNODE)NODE--------------------------------------------------
01000	BEGIN KLNODE; RELEASE  BLOCK OF NODSIZ WORDS.
01100		LAC 1,ARG1↔SOS @BLKCNT
01200		LIPI -3(1)↔LAPI -2(1)		;CLEAR NODE.
01300		SETZM -3(1)↔BLT 8(1)
01400		AOS(1)				;MARK NODE TYPE EMPTY-1.
01500		SUBI 1,3↔LAC@AVAIL		;CONS NODE TO AVAIL LIST.
01600		DAPZ(1)↔DAPZ 1,@AVAIL
01700		POP1J
01800	BEND KLNODE; BGB 4 DEC 1972 --------------------------------------